home *** CD-ROM | disk | FTP | other *** search
/ BBS in a Box 11 / AMUG BBS in a Box Volume XI (April 1994) (MacWizards).iso / Files / Prog / A / 3dlib11.sit / GrafSys.rel / BuildObject ƒ / BuildObject.p next >
Encoding:
Text File  |  1992-04-17  |  9.0 KB  |  322 lines  |  [TEXT/PJMM]
  1. program BuildObject;
  2.  
  3. { This program should be used to create your own 3D objects. Modify the   }
  4. { MakeObject procedure to build your own objects. If the object is what      }
  5. { you wanted, remove the comment marks around the saveobject call and   }
  6. { your object will be saved to the BuildObject.rsc file                                 }
  7. {}
  8. { Copyright (c) 1992 by Christian Franz }
  9.  
  10.     uses
  11.         GrafSys, Screen3D;
  12. (* Matrix, Transformations, Data3D, ResourceAccess, Grafsys, Screen3D; *)
  13.  
  14.     const
  15.         theWindowID = 400;
  16.         degree = 0.01745329; (* π/180 *)
  17.  
  18.     var
  19.         theWindow: WindowPtr;
  20.         theInt: INTEGER;
  21.         thePort: Graf3DPtr;
  22.         theMaster: Graf3DPtr;
  23.         theObject: GrafObjPtr;
  24.         theEvent: EventRecord;
  25.         dx, dy, dz: integer;
  26.         r, PR, VR: Rect;
  27.         SO: ScreenObjPtr;
  28.         dummy: boolean;
  29.  
  30.     procedure MakeObject (var Obj: GrafObjPtr);
  31.  
  32.         var
  33.             count: INTEGER;
  34.             OK: Boolean;
  35.             p: Polygon;
  36.             dummy: integer;
  37.  
  38.     begin
  39.         Obj := NewObject;
  40.         OK := AddPoint(Obj, 300, 500, 0, count); (*house basement *)
  41.         OK := AddPoint(Obj, 300, 900, 0, count);
  42.         OK := AddPoint(Obj, 600, 900, 0, count);
  43.         OK := AddPoint(Obj, 600, 500, 0, count);
  44.         OK := AddPoint(Obj, 300, 500, 200, count); (*house top basement *)
  45.         OK := AddPoint(Obj, 300, 900, 200, count);
  46.         OK := AddPoint(Obj, 600, 900, 200, count);
  47.         OK := AddPoint(Obj, 600, 500, 200, count);
  48.         OK := AddPoint(Obj, 450, 600, 300, count); (* roof *)
  49.         OK := AddPoint(Obj, 450, 800, 300, count);
  50.  
  51.         OK := AddPoint(Obj, 1000, -400, 0, count); (* house garden *)
  52.         OK := AddPoint(Obj, 1000, 1200, 0, count);
  53.         OK := AddPoint(Obj, -300, 1200, 0, count);
  54.         OK := AddPoint(Obj, -300, -400, 0, count);
  55.  
  56.         OK := AddPoint(Obj, 0, 0, 0, count); (* tree at origin *)
  57.         OK := AddPoint(Obj, 0, 0, 300, count);
  58.         OK := AddPoint(Obj, 100, -100, 500, count); (* 17 *)
  59.         OK := AddPoint(Obj, 0, 150, 400, count); (* 18 *)
  60.         OK := AddPoint(Obj, -160, -100, 450, count); (* 19 *)
  61.  
  62.         OK := AddLine(Obj, 1, 2); (* the basement *)
  63.         OK := AddLine(Obj, 2, 3);
  64.         OK := AddLine(Obj, 3, 4);
  65.         OK := AddLine(Obj, 4, 1);
  66.         OK := AddLine(Obj, 1, 5);
  67.         OK := AddLine(Obj, 5, 6);
  68.         OK := AddLine(Obj, 6, 7);
  69.         OK := AddLine(Obj, 7, 8);
  70.         OK := AddLine(Obj, 8, 5);
  71.         OK := AddLine(Obj, 5, 9); (* roof begin *)
  72.         OK := AddLine(Obj, 9, 10);
  73.         OK := AddLine(Obj, 10, 6);
  74.         OK := AddLine(Obj, 6, 2); (* house side 2 *)
  75.         OK := AddLine(Obj, 3, 7);
  76.         OK := AddLine(Obj, 7, 10); (* and the rest *)
  77.         OK := AddLine(Obj, 4, 8);
  78.         OK := AddLine(Obj, 8, 9);
  79.  
  80.         OK := AddLine(Obj, 11, 12); (* garden *)
  81.         OK := AddLine(Obj, 12, 13);
  82.         OK := AddLine(Obj, 13, 14);
  83.         OK := AddLine(Obj, 14, 11);
  84.  
  85.         OK := AddLine(Obj, 15, 16); (* tree *)
  86.         OK := AddLine(Obj, 15, 16);
  87.         OK := AddLine(Obj, 16, 17);
  88.         OK := AddLine(Obj, 17, 18);
  89.         OK := AddLine(Obj, 18, 16);
  90.         OK := AddLine(Obj, 16, 19);
  91.         OK := AddLine(Obj, 19, 17);
  92.         OK := AddLine(Obj, 19, 18);
  93.     end;
  94.  
  95.     procedure getmouserot (var dx, dy, dz: integer);
  96.  
  97.         var
  98.             thePoint: point;
  99.  
  100.     begin
  101.         GetMouse(thePoint);
  102.         dx := 0;
  103.         dy := 0;
  104.         dz := 0;
  105.         if (thePoint.h < thePort^.center.h) and (thePoint.v < thePort^.center.v) then (* mouse in quadrant 1 -> xrot*)
  106.             begin
  107.                 dx := 5;
  108.             end;
  109.         if (thePoint.h > thePort^.center.h) and (thePoint.v < thePort^.center.v) then (* mouse in quadrant 2 -> yrot*)
  110.             begin
  111.                 dy := 5;
  112.             end;
  113.         if (thePoint.h > thePort^.center.h) and (thePoint.v > thePort^.center.v) then (* mouse in quadrant 3 -> zrot*)
  114.             begin
  115.                 dz := 5;
  116.             end;
  117.         if (thePoint.h < thePort^.center.h) and (thePoint.v > thePort^.center.v) then (* mouse in quadrant 4 -> idle*)
  118.             begin
  119.             end;
  120.         if button then
  121.             begin
  122.                 dx := -dx;
  123.                 dy := -dy;
  124.                 dz := -dz;
  125.             end;
  126.     end;
  127.  
  128.  
  129.     const
  130.         closer = 58;  (* option Key *)
  131.         further = 55; (* command key *)
  132.         haltkey = 76; (* keypad enter *)
  133.  
  134.         leftArrow = $7B;
  135.         rightArrow = $7C;
  136.         upArrow = $7E;
  137.         downArrow = $7D;
  138.  
  139.         num1 = $53;
  140.         num2 = $54;
  141.         upKey = $22; (* I *)
  142.         downKey = $2E; (* M *)
  143.         leftKey = $26; (* J *)
  144.         rightKey = $28;(* K *)
  145.         forwardKey = $0C; (* Q *)
  146.         backwardKey = $00; (* A *)
  147.  
  148.     var
  149.  
  150.         theKeys: KeyMap;
  151.         theta, phi: integer;
  152.         pitch: integer;
  153.         update: boolean;
  154.         x, y, z: Real;
  155.  
  156. (* Procedure to read keyboard commands. the following commands are defined: *)
  157. (*                                                                                *)
  158. (* Option : translate object up down on z-achsis           *)
  159. (* Command : translate object up on z-achsis               *)
  160. (*                                                                                *)
  161. (* leftArrow : decrease theta                                      *)
  162. (* right arrow : increase theta                                    *)
  163. (* upArrow : increase phi                                            *)
  164. (* downarrow : decrease phi                                       *)
  165. (* numblock-1 : decrease pitch                                    *)
  166. (* numblock-2 : increase pitch                                     *)
  167. (*                                                                                *)
  168. (* Enter : stop program                                               *)
  169.  
  170.     procedure KeyCommand;
  171.  
  172.     begin
  173.         GetKeys(theKeys);
  174.         if theKeys[further] then
  175.             ObjTranslate(theObject, 0, 0, 10);
  176.         if theKeys[closer] then
  177.             ObjTranslate(theObject, 0, 0, -10);
  178.         if theKeys[leftArrow] then
  179.             begin
  180.                 theta := (theta + 5) mod 355;
  181.                 SetEye(true, x, y, z, phi * degree, theta * degree, pitch * degree, 1.54079633, true);
  182.                 update := true;
  183.             end;
  184.  
  185.         if theKeys[rightArrow] then
  186.             begin
  187.                 theta := (theta - 5) mod 355;
  188.                 SetEye(true, x, y, z, phi * degree, theta * degree, pitch * degree, 1.54079633, true);
  189.                 update := true;
  190.             end;
  191.  
  192.         if theKeys[upArrow] then
  193.             begin
  194.                 phi := (phi + 5) mod 355;
  195.                 SetEye(true, x, y, z, phi * degree, theta * degree, pitch * degree, 1.54079633, true);
  196.                 update := true;
  197.             end;
  198.  
  199.         if theKeys[downArrow] then
  200.             begin
  201.                 phi := (phi - 5) mod 355;
  202.                 SetEye(true, x, y, z, phi * degree, theta * degree, pitch * degree, 1.54079633, true);
  203.                 update := true;
  204.             end;
  205.  
  206.         if theKeys[num1] then
  207.             begin
  208.                 pitch := (pitch + 5) mod 355;
  209.                 SetEye(true, x, y, z, phi * degree, theta * degree, pitch * degree, 1.54079633, true);
  210.                 update := true;
  211.             end;
  212.  
  213.         if theKeys[num2] then
  214.             begin
  215.                 pitch := (pitch - 5) mod 355;
  216.                 SetEye(true, x, y, z, phi * degree, theta * degree, pitch * degree, 1.54079633, true);
  217.                 update := true;
  218.             end;
  219.  
  220.         if theKeys[upKey] then
  221.             begin
  222.                 z := (z + 5);
  223.                 SetEye(true, x, y, z, phi * degree, theta * degree, pitch * degree, 1.54079633, true);
  224.                 update := true;
  225.             end;
  226.  
  227.         if theKeys[downKey] then
  228.             begin
  229.                 z := (z - 5);
  230.                 SetEye(true, x, y, z, phi * degree, theta * degree, pitch * degree, 1.54079633, true);
  231.                 update := true;
  232.             end;
  233.  
  234.         if theKeys[leftKey] then
  235.             begin
  236.                 y := (y - 5);
  237.                 SetEye(true, x, y, z, phi * degree, theta * degree, pitch * degree, 1.54079633, true);
  238.                 update := true;
  239.             end;
  240.  
  241.         if theKeys[rightKey] then
  242.             begin
  243.                 y := (y + 5);
  244.                 SetEye(true, x, y, z, phi * degree, theta * degree, pitch * degree, 1.54079633, true);
  245.                 update := true;
  246.             end;
  247.  
  248.         if theKeys[forwardKey] then
  249.             begin
  250.                 x := (x + 5);
  251.                 SetEye(true, x, y, z, phi * degree, theta * degree, pitch * degree, 1.54079633, true);
  252.                 update := true;
  253.             end;
  254.  
  255.  
  256.         if theKeys[backwardKey] then
  257.             begin
  258.                 x := (x - 5);
  259.                 SetEye(true, x, y, z, phi * degree, theta * degree, pitch * degree, 1.54079633, true);
  260.                 update := true;
  261.             end;
  262.     end;
  263.  
  264. (* main program *)
  265.  
  266. begin
  267.     InitCursor;
  268.     theWindow := GetNewWindow(theWindowID, nil, Pointer(-1));
  269.     SetPort(theWindow); (* draw in this window *)
  270.     MoveTo(10, 10);
  271.     DrawString('3D GrafSys.      TestObject.    (C) 1992 by CF.');
  272.     InitGrafSys;
  273.     NewGrafport(theWindow^.portRect, thePort);
  274.  
  275.     MoveTo(10, 25 * 15);
  276.     DrawString('Descr. : Press Keypad-Enter to stop');
  277.     MoveTo(10, 26 * 15);
  278.     DrawString('            Option to zoom closer');
  279.     MoveTo(10, 27 * 15);
  280.     DrawString('            Command to move further away');
  281.     MoveTo(10, 28 * 15);
  282.     DrawString('            Move mouse into fighter to rotate it');
  283.  
  284.     PR := theWindow^.PortRect;
  285.     SetRect(VR, thePort^.center.h - 0, thePort^.center.v - 100, thePort^.center.h + 220, thePort^.center.v + 100);
  286.     r := VR;
  287.     for dx := 1 to 3 do
  288.         begin
  289.             InsetRect(r, -2, -2);
  290.             FrameRect(r);
  291.         end;
  292.     SetView(PR, VR);
  293.     SetCenter(thePort^.center.h + 120, thePort^.center.v);
  294.     MakeObject(theObject);
  295. (* SaveObject(theObject, 'House & Garden', 1102); *)
  296.  
  297.     phi := 0;
  298.     theta := 0;
  299.     pitch := 0;
  300.     x := 0;
  301.     y := 0;
  302.     z := 0;
  303.     SetEye(true, x, y, z, phi * degree, theta * degree, pitch * degree, 1.54079633, true);
  304.     ObjTranslate(theObject, 0, 0, 0);
  305.     ObjRotate(theObject, 0 * degree, 0 * degree, 0);
  306.     SetAutoErase(theObject, true);
  307.     SO := NewScreenObject;
  308.     AttachScreenObject(SO, theObject); (* Link for all changes *)
  309.     CCalcScreenObject(theObject, TRUE);
  310.     DrawScreenObject(theObject);
  311.  
  312.     repeat
  313.         GetMouseRot(dx, dy, dz);
  314.         if (dx + dy + dz <> 0) or (theKeys[closer]) or (theKeys[further]) or update then
  315.             DrawScreenObject(theObject); (* draw Object *)
  316.         update := false;
  317.         ObjRotate(theObject, dx * degree, dy * degree, dz * degree);
  318.         KeyCommand; (* look at keyboard and do action required *)
  319.         CCalcScreenObject(theObject, TRUE);
  320.     until theKeys[haltkey];
  321.  
  322. end.